SOCR ≫ DSPA ≫ Topics ≫

This DSPA section Appendix.3.1 (Primitive Surfaces with and without Boundaries) is part of the DSPA Appendix on visualizaiton of geometric and parametric surfaces. This DSPA Appendix (3) covers the following 3 topics:

1 (Section 3.1) Geometric Primitive Surfaces with and without Boundaries

1.1 Saddle Point Surface

A saddle point is a point on the surface represented by a function \(z=z(x,y)\), where the gradient slopes (partial derivatives) of orthogonal function components defining the surface are trivial (\(0\)), however the point does not represent a local extremum on both axes, as may be expected. We already showed a simple example of a saddle point earlier, which we rendered as a surface. Now we will illustrate the parametric definition of a surface with a saddle point and it’s triangulated representation as a mesh3d.

library(plotly)
library (geometry)

# Plotly layout 
axs <- list(
  backgroundcolor="rgb(200,200,200)", # gray
  gridcolor="rgb(255,255,255)",       # white
  showbackground=TRUE,
  zerolinecolor="rgb(255,255,255)"     # white
)

n <- 36
h <- 1/(n-1)
r = seq(h, 1, length.out=n)
theta = seq(0, 2*pi, length.out=100)
 
grid.df <- expand.grid(r=r, theta=theta)
 
x <- c(grid.df$r * cos(grid.df$theta), 0)
y <- c(grid.df$r * sin(grid.df$theta), 0)
z <- sin(x*y)
 
mat <- matrix(
  c(x,y,z), 
  ncol = 3,
  dimnames = list(NULL, c("x", "y", "z"))
)
 
triangulated <- delaunayn(mat[,1:2])
 
# now figure out the colormap
zmean <- apply(triangulated, MARGIN=1, function(row){mean(mat[row,3])})
 
library(scales)

facecolor = colour_ramp(
  colorRampPalette(c("pink", "purple"))(20)
)(rescale(x=zmean))
 
plot_ly(
  x=x, y=y, z=z,
  i=triangulated[,1]-1, j=triangulated[,2]-1, k=triangulated[,3]-1,
  facecolor=facecolor,
  type="mesh3d",
  opacity = 0.7,
  contour=list(show=TRUE, color="#000", width=15)
) %>%
  layout(
    title="Triangulated Saddle Point surface",
    scene=list(
      xaxis=axs,
      yaxis=axs,
      zaxis=axs,
      camera=list(
        eye=list(x=1.75,y=-0.7,z=0.75)
      )
    )
  )

1.2 Geometric Shapes: 3D Spherical Parameterization

Below, we show three complementary examples of rendering synthetic geometric shapes; convex shapes (cone, sphere) and a non-convex surface (complex). It’s worthwhile reviewing the fundamentals of the spherical coordinate system representation.

# library(plotly)

# sweep or define (u,v) spherical coordiante parameter ranges
phi <- seq(from = 0, to = 2*pi, by = ((2*pi - 0)/(200 - 1)))
psi <- seq(from = 0, to = pi, by = ((pi - 0)/(200 - 1)))

#p <- plot_ly(x = ~x, y = ~y, z = ~z, type = 'surface', opacity=1,
#             contour=list(show=TRUE, color="#000", width=15, lwd=10))  %>%
#  layout(title = paste("Layout ", shape), 
#         scene = list(xaxis=x_label,yaxis=y_label, zaxis=z_label))
#p

# shape=="complex")
    # rendering (u,v) parametric surfaces requires x,y,z arguments to be 2D arrays
    # In out case, the three coordinates have to be 200*200 parameterized tensors/arrays
    r1 = 2 + sin(3 * phi + 5 * psi)    # r = 2 + sin(7phi+5psi)
    x1 = (r1 * cos(phi)) %o% sin(psi)    # x = r*cos(phi)*sin(psi)
    y1 = (r1 * sin(phi)) %o% sin(psi)     # y = r*sin(phi)*sin(psi)
    z1 = r1 %o% cos(psi)  # z = r*cos(psi)
    
#shape=="cone")
    h2= 10   # cone height
    r2 = seq(from = 0, to = h2, by = ((h2 - 0)/(200 - 1)))  # r = radius
    x2 = 3* ((h2 - r2)/h2 ) %o% rep(1, 200)             # x = 3*r
    y2 = 3* ((h2 - r2)/h2 ) %o% sin(phi)   # y = r*sin(phi)
    z2 = 3* ((h2 - r2)/h2 ) %o% cos(phi)   # z = r*cos(phi)

#shape=="sphere") 
    r3 = 1                           # r = 1
    x3 = r3 * cos(phi) %o% sin(psi)   # x = r*cos(phi)*sin(psi)
    y3 = r3 * sin(phi) %o% sin(psi)   # y = r*sin(phi)*sin(psi)
    z3 = r3 * rep(1, 200) %o% cos(psi) # still need z to be 200*200 parameterized tensor/array

shape_names <- c("complex", "cone", "sphere")

# https://plot.ly/r/custom-buttons/

#p <- plot_ly(x = ~x, y = ~y, z = ~z, type = 'surface', opacity=1,
#             contour=list(show=TRUE, color="#000", width=15, lwd=10),
#             layout=layout_shapes)

# updatemenus component
updatemenus <- list(
  list(
    active = -1,
    type = 'buttons',
    buttons = list(
      list(
        label = shape_names[1],
        method = "update",
        args = list(list(visible = c(TRUE, FALSE, FALSE)),
                    list(title = shape_names[1]))),
      list(
        label = shape_names[2],
        method = "update",
        args = list(list(visible = c(FALSE, TRUE, FALSE)),
                    list(title = shape_names[2]))),
      list(
        label = shape_names[3],
        method = "update",
        args = list(list(visible = c(FALSE, FALSE, TRUE)),
                    list(title = shape_names[3])))
    )
  )
)

p <- plot_ly(hoverinfo="none", legendshow=FALSE, showscale = FALSE) %>%
  add_trace(x = ~x1, y = ~y1, z = ~z1, type = 'surface', opacity=1, visible=T,
             contour=list(show=TRUE, color="#000", width=15, lwd=10,
                          opacity=1.0, hoverinfo="none", legendshow=F)) %>%
  add_trace(x = ~x2, y = ~y2, z = ~z2, type='surface', opacity=1,visible=F,
             contour=list(show=TRUE, color="#000", width=15, lwd=10,
                          opacity=1.0, hoverinfo="none", legendshow=F)) %>%
  add_trace(x = ~x3, y = ~y3, z = ~z3, type = 'surface', opacity=0.7,visible=F,
             contour=list(show=TRUE, color="#000", width=15, lwd=10,
                          opacity=0.7, hoverinfo="none", legendshow=F)) %>%
  layout(title = "Choose a Shape", showlegend = FALSE,
         updatemenus = updatemenus)
p

2 References

SOCR Resource Visitor number SOCR Email